home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_gen / euphor14.zip / SHELL.BAS < prev    next >
BASIC Source File  |  1994-06-05  |  1KB  |  72 lines
  1. DECLARE SUB sort ()
  2.  
  3. DEFINT A-Z
  4.  
  5. CONST BATCH = 100
  6. CONST BENCHTIME = 15
  7. CONST NITEMS = 50
  8. DIM SHARED xlist(NITEMS), slist(NITEMS)
  9.  
  10. DATA 9, 34, 14, 18, 33, 46, 11, 13, 7, 26, 22, 10, 36, 40, 2, 28, 32, 1
  11. DATA 23, 31, 43, 5, 24, 42, 45, 50, 16, 3, 47, 39, 21, 49, 41, 6, 19, 30
  12. DATA 20, 35, 44, 38, 25, 15, 27, 17, 8, 4, 29, 37, 48, 12
  13.  
  14. FOR i = 1 TO NITEMS
  15.     READ xlist(i)
  16. NEXT i
  17.  
  18. PRINT "shell sort benchmark ..."
  19.  
  20. cycles& = 0
  21. t# = TIMER
  22. WHILE TIMER < t# + BENCHTIME
  23.     FOR b = 1 TO BATCH
  24.         REM must preserve the original array
  25.         FOR x = 1 TO NITEMS
  26.         slist(x) = xlist(x)
  27.         NEXT x
  28.         sort
  29.     NEXT b
  30.     cycles& = cycles& + BATCH
  31. WEND
  32. t# = TIMER - t#
  33. PRINT USING "######.## sorts per second"; cycles& / t#
  34.  
  35. FOR i = 1 TO NITEMS
  36.     PRINT slist(i),
  37. NEXT i
  38.  
  39. SYSTEM
  40.  
  41. SUB sort
  42. REM put slist into ascending order
  43. REM using a shell sort
  44.     
  45.     gap = INT(NITEMS / 4) + 1
  46.     DO
  47.     FOR i = gap + 1 TO NITEMS
  48.         tempi = slist(i)
  49.         j = i - gap
  50.         DO
  51.         tempj = slist(j)
  52.         IF tempi >= tempj THEN
  53.             j = j + gap
  54.             EXIT DO
  55.         END IF
  56.         slist(j + gap) = tempj
  57.         IF j <= gap THEN
  58.             EXIT DO
  59.         END IF
  60.         j = j - gap
  61.         LOOP
  62.         slist(j) = tempi
  63.     NEXT i
  64.     IF gap = 1 THEN
  65.         EXIT SUB
  66.     ELSE
  67.         gap = INT(gap / 4) + 1
  68.     END IF
  69.     LOOP
  70. END SUB
  71.  
  72.